home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / GENHTML.PRG < prev    next >
Encoding:
Text File  |  1998-05-26  |  20.1 KB  |  736 lines
  1. * GenHTML.PRG - HTML Generator.
  2. *
  3. * Copyright (c) 1998 Microsoft Corp.
  4. * 1 Microsoft Way
  5. * Redmond, WA 98052
  6. *
  7. * Description:
  8. * HTML generator using classes in _HTML.VCX.
  9. *
  10. * Parameter list:
  11. * cOutFile:            Specifies the name of the output .HTM file.  If a file name without
  12. *                    an extention is specified, .HTM is used.
  13. * vSource:            Specifies the source file name, alias or object.
  14. * nShow:             0/.F./Empty = Generate output file only.
  15. *                    1 = Create output file and view generated file.
  16. *                    2 = Create output file and show generated file in Internet Explorer.
  17. *                    3 = Create output file and show based on Save As HTML dialog selection.
  18. *                    4 = Create PUBLIC _oHTML object and generate file.
  19. *                    5 = Create PUBLIC _oHTML object without generating file.
  20. * vIELink:            Specifies a link to Internet Explorer object or Web Browser control.
  21. *                    .F./Empty = No link is created.
  22. *                    .T. = Automatically create instance of Internet Explorer.
  23. *                    Object = Reference to Internet Explorer or Web Browser control.
  24. * cStyle:            Specifies Style ID reference in GenHTML.dbf.
  25. * cScope:            Specifies the scope of scan by setting .cScope.
  26. * cHTMLClass:        Specifies the Class, and optionally, the class library and module,
  27. *                    that is    instantiated for HTML object.
  28. *                    Syntax: Class[,ClassLibrary[,Module]]
  29.  
  30.  
  31. *-- Types
  32. #DEFINE VFP_DEFAULT_ID                "VFPDefault"
  33.  
  34. *-- Messages
  35. #DEFINE M_CLASS_LOC                    "Class"
  36. #DEFINE M_COULD_NOT_BE_INST_LOC        "could not be instantiated"
  37. #DEFINE M_COULD_NOT_OPENED_EXCL_LOC    "could not be opened exclusively to update the table structure."
  38. #DEFINE M_FILE_LOC                    "File"
  39. #DEFINE M_FILE_ALREADY_EXISTS_LOC    "This file already exists."
  40. #DEFINE M_FILE_TYPE_LOC                "File type"
  41. #DEFINE M_GENHTML_LOC                "GenHTML"
  42. #DEFINE M_INVALID_SOURCE_REF_LOC    "Invalid source reference"
  43. #DEFINE M_NOT_FOUND_LOC                "not found"
  44. #DEFINE M_NOT_SUPPORTED_LOC            "not supported"
  45. #DEFINE M_OF_LOC                    "of"
  46. #DEFINE M_PROPERTIES_LOC            "Properties"
  47. #DEFINE M_STYLE_LOC                    "style"
  48. #DEFINE M_REPLACE_EXISTING_FILE_LOC    "Replace existing file"
  49. #DEFINE M_UNABLE_TO_CREATE_FILE_LOC    "Unable to create file"
  50. #DEFINE M_UNABLE_TO_FIND_LOC        "Unable to find"
  51. #DEFINE M_UNABLE_TO_OPEN_FILE_LOC    "Unable to open file"
  52.  
  53. *-- ASCII codes
  54. #DEFINE TAB        CHR(9)
  55. #DEFINE LF        CHR(10)
  56. #DEFINE CR        CHR(13)
  57. #DEFINE CR_LF    CR+LF
  58.  
  59.  
  60. LPARAMETERS tcOutFile,tvSource,tnShow,tvIELink,tcStyle,tcScope,tcHTMLClass
  61. LOCAL lcOutFile,lvSource,oSource,lnShow,lcStyle,lcScope,lcHTMLClass,lcHTMLClassLib
  62. LOCAL lcHTMLModule,lcHTMLVCX,lnSourceListCount,lcLastOnError,llSaveAsHTML,lcText
  63. LOCAL oRecord,lcGenHTMLTable,lcGenHTMLAlias,lnGenHTMLRecNo,oSaveEnvironment
  64. LOCAL lcProgramPath,lcIELinkType,llIELink,oSaveAsHTMLForm,oSaveAsHTML,lnCount
  65. LOCAL lcTitle,lcSourceVarType,lcSourceFileExt,ll_oHTMLPublic,llSuccessful,lnAtPos
  66. LOCAL laSourceList[1,1],laSelObj[1],laLines[1]
  67.  
  68. oSaveEnvironment=NEWOBJECT("_SaveEnvironment")
  69. lcProgramPath=JUSTPATH(LOWER(SYS(16)))+"\"
  70. lcHTMLVCX=IIF(VERSION(2)=0,"",HOME()+"FFC\")+"_HTML.vcx"
  71. lcOutFile=IIF(VARTYPE(tcOutFile)=="C",LOWER(ALLTRIM(tcOutFile)),"")
  72. IF NOT EMPTY(lcOutFile) AND EMPTY(JUSTEXT(lcOutFile))
  73.     lcOutFile=FORCEEXT(lcOutFile,"htm")
  74. ENDIF
  75. lnShow=IIF(VARTYPE(tnShow)=="N" OR VARTYPE(tnShow)=="I",MIN(MAX(INT(tnShow),0),5),0)
  76. lcSourceVarType=VARTYPE(tvSource)
  77. DO CASE
  78.     CASE lcSourceVarType=="C"
  79.         lvSource=ALLTRIM(tvSource)
  80.     CASE lcSourceVarType=="O"
  81.         lvSource=tvSource
  82.     OTHERWISE
  83.         lvSource=""
  84.         lcSourceVarType="C"
  85. ENDCASE
  86. laSourceList=""
  87. lnSourceListCount=0
  88. IF lcSourceVarType=="C"
  89.     IF EMPTY(lvSource) AND lnShow#5
  90.         lvSource=LOWER(GETFILE("dbf;frx;lbx;mnx;scx"))
  91.         IF EMPTY(lvSource)
  92.             RETURN .NULL.
  93.         ENDIF
  94.     ELSE
  95.         IF NOT CR$lvSource
  96.             lvSource=STRTRAN(lvSource,",",CR)
  97.         ENDIF
  98.         IF MEMLINES(lvSource)>=2
  99.             lnSourceListCount=ALINES(laLines,lvSource)
  100.             lvSource=laLines[1]
  101.             lnSourceListCount=lnSourceListCount-1
  102.             ADEL(laLines,1)
  103.             DIMENSION laLines[lnSourceListCount]
  104.             lnCount=0
  105.             DO WHILE .T.
  106.                 lnCount=lnCount+1
  107.                 IF lnCount>lnSourceListCount
  108.                     EXIT
  109.                 ENDIF
  110.                 IF NOT EMPTY(laLines[lnCount])
  111.                     LOOP
  112.                 ENDIF
  113.                 ADEL(laLines,lnCount)
  114.                 lnSourceListCount=lnSourceListCount-1
  115.             ENDDO
  116.             IF lnSourceListCount>=1
  117.                 DIMENSION laSourceList[lnSourceListCount,2]
  118.                 FOR lnCount = 1 TO lnSourceListCount
  119.                     lcText=ALLTRIM(laLines[lnCount])
  120.                     lnAtPos=AT("@",lcText)
  121.                     IF lnAtPos>0
  122.                         laSourceList[lnCount,1]=ALLTRIM(SUBSTR(lcText,lnAtPos+1))
  123.                         laSourceList[lnCount,2]=ALLTRIM(LEFT(lcText,lnAtPos-1))
  124.                     ELSE
  125.                         laSourceList[lnCount,1]=lcText
  126.                         laSourceList[lnCount,2]=""
  127.                     ENDIF
  128.                 ENDFOR
  129.             ENDIF
  130.         ENDIF
  131.     ENDIF
  132.     lcSourceFileExt=LOWER(JUSTEXT(lvSource))
  133.     IF NOT "!"$lvSource AND NOT EMPTY(lcSourceFileExt)
  134.         lvSource=LOWER(FULLPATH(lvSource))
  135.     ENDIF
  136. ENDIF
  137. lcIELinkType=VARTYPE(tvIELink)
  138. llIELink=INLIST(lcIELinkType,"L","O")
  139. lcStyle=IIF(VARTYPE(tcStyle)=="C",LOWER(ALLTRIM(tcStyle)),"")    
  140. lcScope=IIF(VARTYPE(tcScope)=="C",LOWER(ALLTRIM(tcScope)),"ALL")
  141. lcHTMLClass=IIF(VARTYPE(tcHTMLClass)=="C",LOWER(ALLTRIM(tcHTMLClass)),"")
  142. llSaveAsHTML=(lnShow=3)
  143. lcGenHTMLTable=lcProgramPath+"GenHTML.dbf"
  144. lcGenHTMLAlias=LOWER(SYS(2015))
  145. SELECT 0
  146. lcLastOnError=ON("ERROR")
  147. ON ERROR =.F.
  148. USE (lcGenHTMLTable) AGAIN SHARED ALIAS (lcGenHTMLAlias)
  149. IF EMPTY(lcLastOnError)
  150.     ON ERROR
  151. ELSE
  152.     ON ERROR &lcLastOnError
  153. ENDIF
  154. IF NOT _CheckGenHTMLTableStructure(lcGenHTMLTable,lcGenHTMLAlias,lcHTMLVCX)
  155.     RETURN .NULL.
  156. ENDIF
  157. SET FILTER TO NOT DELETED()
  158. LOCATE
  159. oSaveEnvironment.cGenHTMLTable=lcGenHTMLTable
  160. oSaveEnvironment.cGenHTMLAlias=lcGenHTMLAlias
  161. IF EMPTY(lcStyle)
  162.     lcStyle=LOWER(VFP_DEFAULT_ID)
  163. ENDIF
  164. LOCATE FOR LOWER(ALLTRIM(ID))==lcStyle
  165. IF EOF()
  166.     USE
  167.     _MsgBox(M_UNABLE_TO_FIND_LOC+[ ]+M_STYLE_LOC+[ "]+lcStyle+[".])
  168.     RETURN .NULL.
  169. ENDIF
  170. lnGenHTMLRecNo=RECNO()
  171. oSaveEnvironment.nGenHTMLRecNo=lnGenHTMLRecNo
  172. SCATTER MEMO NAME oRecord
  173. _EvalLinks(Links,oRecord)
  174. GO lnGenHTMLRecNo
  175. SELECT 0
  176. IF EMPTY(lcHTMLClass) AND NOT EMPTY(oRecord.ClassName)
  177.     lcHTMLClass=LOWER(ALLTRIM(MLINE(oRecord.ClassName,1)))
  178. ENDIF
  179. IF EMPTY(lcHTMLClassLib) AND NOT EMPTY(oRecord.ClassLib)
  180.     lcHTMLClassLib=LOWER(ALLTRIM(MLINE(oRecord.ClassLib,1)))
  181. ENDIF
  182. IF EMPTY(lcHTMLModule) AND NOT EMPTY(oRecord.Module)
  183.     lcHTMLModule=LOWER(ALLTRIM(MLINE(oRecord.Module,1)))
  184. ENDIF
  185. IF lnShow=3
  186.     oSaveAsHTMLForm=NEWOBJECT("_HTMLSaveAsDialog",lcHTMLVCX)
  187.     IF VARTYPE(oSaveAsHTMLForm)#"O"
  188.         RETURN .NULL.
  189.     ENDIF
  190.     oSaveAsHTML=NEWOBJECT("Custom")
  191.     oSaveAsHTML.AddProperty("cOutFile","")
  192.     oSaveAsHTML.AddProperty("nShow",0)
  193.     WITH oSaveAsHTMLForm
  194.         .oSaveAsHTML=oSaveAsHTML
  195.         .txtOutFile.Value=lcOutFile
  196.         .Show
  197.         lcOutFile=.oSaveAsHTML.cOutFile
  198.         lnShow=.oSaveAsHTML.nShow
  199.         IF EMPTY(lcOutFile)
  200.             RETURN .NULL.
  201.         ENDIF
  202.     ENDWITH
  203.     IF EMPTY(lcOutFile)
  204.         RETURN .NULL.
  205.     ENDIF
  206. ENDIF
  207. IF (llSaveAsHTML OR oSaveEnvironment.cLastSetSafety=="ON") AND ;
  208.         NOT EMPTY(lcOutFile) AND FILE(lcOutFile) AND ;
  209.     _MsgBox(lcOutFile+CR_LF+M_FILE_ALREADY_EXISTS_LOC+CR_LF+CR_LF+ ;
  210.             M_REPLACE_EXISTING_FILE_LOC+"?",292)#6
  211.     RETURN .NULL.
  212. ENDIF
  213. ll_oHTMLPublic=(TYPE("_oHTML")#"U")
  214. IF ll_oHTMLPublic AND VARTYPE(_oHTML)=="O" AND PEMSTATUS(_oHTML,"Release",5)
  215.     _oHTML.Release
  216. ENDIF
  217. RELEASE _oHTML
  218. IF ll_oHTMLPublic OR lnShow=4 OR lnShow=5
  219.     ll_oHTMLPublic=.T.
  220.     PUBLIC _oHTML
  221. ELSE
  222.     PRIVATE _oHTML
  223. ENDIF
  224. _oHTML=.NULL.
  225. lcHTMLModule=""
  226. lnAtPos=AT(",",lcHTMLClass)
  227. IF lnAtPos>0
  228.     lcHTMLClassLib=ALLTRIM(SUBSTR(lcHTMLClass,lnAtPos+1))
  229.     lcHTMLClass=ALLTRIM(LEFT(lcHTMLClass,lnAtPos-1))
  230.     lnAtPos=AT(",",lcHTMLClassLib)
  231.     IF lnAtPos>0
  232.         lcHTMLModule=ALLTRIM(SUBSTR(lcHTMLClassLib,lnAtPos+1))
  233.         lcHTMLClassLib=ALLTRIM(LEFT(lcHTMLClassLib,lnAtPos-1))
  234.     ENDIF
  235. ELSE
  236.     IF EMPTY(lcHTMLClassLib)
  237.         lcHTMLClassLib=LOWER(lcHTMLVCX)
  238.     ENDIF
  239. ENDIF
  240. IF LEFT(lcHTMLClass,1)=="(" AND RIGHT(lcHTMLClass,1)==")"
  241.     lcHTMLClass=EVALUATE(SUBSTR(lcHTMLClass,2,LEN(lcHTMLClass)-2))
  242. ENDIF
  243. IF LEFT(lcHTMLClassLib,1)=="(" AND RIGHT(lcHTMLClassLib,1)==")"
  244.     lcHTMLClassLib=EVALUATE(SUBSTR(lcHTMLClassLib,2,LEN(lcHTMLClassLib)-2))
  245. ENDIF
  246. IF LEFT(lcHTMLModule,1)=="(" AND RIGHT(lcHTMLModule,1)==")"
  247.     lcHTMLModule=EVALUATE(SUBSTR(lcHTMLModule,2,LEN(lcHTMLModule)-2))
  248. ENDIF
  249. IF NOT EMPTY(lcHTMLClassLib) AND EMPTY(JUSTEXT(lcHTMLClassLib))
  250.     lcHTMLClassLib=FORCEEXT(lcHTMLClassLib,"vcx")
  251. ENDIF
  252. IF NOT EMPTY(lcHTMLModule) AND EMPTY(JUSTEXT(lcHTMLModule))
  253.     lcHTMLModule=FORCEEXT(lcHTMLModule,"app")
  254. ENDIF
  255. IF NOT EMPTY(lcHTMLClassLib) AND NOT FILE(lcHTMLClassLib)
  256.     _MsgBox(M_FILE_LOC+[ "]+lcHTMLClassLib+[" ]+M_NOT_FOUND_LOC+[.])
  257.     RETURN .NULL.
  258. ENDIF
  259. IF NOT EMPTY(lcHTMLModule) AND NOT FILE(lcHTMLModule)
  260.     _MsgBox(M_FILE_LOC+[ "]+lcHTMLModule+[" ]+M_NOT_FOUND_LOC+[.])
  261.     RETURN .NULL.
  262. ENDIF
  263. oSource=.NULL.
  264. DO CASE
  265.     CASE NOT EMPTY(lcHTMLClass)
  266.         =.F.
  267.     CASE lcSourceVarType=="O"
  268.         oSource=lvSource
  269.         lcHTMLClass="_HTMLObject"
  270.     CASE lcSourceVarType=="C" AND NOT EMPTY(lvSource)
  271.         DO CASE
  272.             CASE EMPTY(lcSourceFileExt) AND NOT EMPTY(lvSource)
  273.                 lcHTMLClass="_HTMLTable"
  274.             CASE NOT FILE(lvSource)
  275.                 _MsgBox([File "]+lvSource+[" not found.])
  276.                 RETURN .NULL.
  277.             CASE lcSourceFileExt=="dbf"
  278.                 lcHTMLClass="_HTMLTable"
  279.             CASE lcSourceFileExt=="frx"
  280.                 lcHTMLClass="_HTMLReport"
  281.             CASE lcSourceFileExt=="lbx"
  282.                 lcHTMLClass="_HTMLLabel"
  283.             CASE lcSourceFileExt=="mnx"
  284.                 lcHTMLClass="_HTMLMenu"
  285.             CASE lcSourceFileExt=="scx"
  286.                 lcHTMLClass="_HTMLObject"
  287.                 oSaveEnvironment.cWindow=LOWER(SYS(2015))
  288.                 DEFINE WINDOW (oSaveEnvironment.cWindow) FROM 0,0 TO 0,0 NONE
  289.                 MODIFY FORM (lvSource) IN WINDOW (oSaveEnvironment.cWindow) NOWAIT
  290.                 IF ASELOBJ(laSelObj,1)#1
  291.                     RELEASE WINDOW (oSaveEnvironment.cWindow)
  292.                     _MsgBox(M_UNABLE_TO_OPEN_FILE_LOC+[ "]+lvSource+[".])
  293.                     RETURN .NULL.
  294.                 ENDIF
  295.                 oSource=laSelObj[1]
  296.                 IF WVISIBLE(M_PROPERTIES_LOC)
  297.                     oSaveEnvironment.lWindow=.T.
  298.                     HIDE WINDOW (M_PROPERTIES_LOC)
  299.                 ENDIF
  300.             OTHERWISE
  301.                 IF EMPTY(lvSource)
  302.                     _MsgBox(M_INVALID_SOURCE_REF_LOC+".")
  303.                 ELSE
  304.                     _MsgBox(M_FILE_TYPE_LOC+" "+lvSource+" "+M_NOT_SUPPORTED_LOC+".")
  305.                 ENDIF
  306.                 RETURN .NULL.
  307.         ENDCASE
  308.     OTHERWISE
  309.         lcHTMLClass="_HTMLDocument"
  310. ENDCASE
  311. lcLastOnError=ON("ERROR")
  312. ON ERROR =.F.
  313. _oHTML=NEWOBJECT(lcHTMLClass,lcHTMLClassLib)
  314. IF EMPTY(lcLastOnError)
  315.     ON ERROR
  316. ELSE
  317.     ON ERROR &lcLastOnError
  318. ENDIF
  319. IF VARTYPE(_oHTML)#"O"
  320.     _oHTML=.NULL.
  321.     _MsgBox(M_CLASS_LOC+[ (]+lcHTMLClass+[) ]+M_OF_LOC+[ "]+LOWER(lcHTMLClassLib)+ ;
  322.             [" ]+M_COULD_NOT_BE_INST_LOC+[.])
  323.     RETURN .NULL.
  324. ENDIF
  325. IF lnShow#5 AND EMPTY(lcOutFile)
  326.     lcOutFile=_oHTML.GetFile()
  327.     IF EMPTY(lcOutFile)
  328.         IF VARTYPE(_oHTML)=="O"
  329.             _oHTML.Release
  330.         ENDIF
  331.         _oHTML=.NULL.
  332.         RETURN .NULL.
  333.     ENDIF
  334. ENDIF
  335. IF llIELink
  336.     DO CASE
  337.         CASE lcIELinkType=="L" AND tvIELink
  338.             _oHTML.CreateIELink
  339.         CASE lcIELinkType=="O"
  340.             _oHTML.IE=tvIELink
  341.     ENDCASE
  342. ENDIF
  343. _oHTML.oRecord=oRecord
  344. _oHTML.cGenHTMLTable=lcGenHTMLTable
  345. _oHTML.cGenHTMLAlias=lcGenHTMLAlias
  346. _oHTML.lMessageBar=.T.
  347. _oHTML.cOutFile=lcOutFile
  348. _oHTML.oSource=oSource
  349. _oHTML.cSourceFile=IIF(VARTYPE(lvSource)=="C",lvSource,"")
  350. _oHTML.nSourceListCount=lnSourceListCount
  351. ACOPY(laSourceList,_oHTML.aSourceList)
  352. _oHTML.cScope=lcScope
  353. _oHTML.oProperties=_oHTML.NewTag()
  354. _oHTML.oProperties.SetProperties(oRecord.Properties)
  355. _oHTML.RunCode(_oHTML.oRecord.PreScript)
  356. IF PEMSTATUS(_oHTML,"Head",5)
  357.     _oHTML.Head.AddItem(_oHTML.oRecord.HeadStart)
  358.     IF EMPTY(_oHTML.cSourceFile)
  359.         IF VARTYPE(lvSource)=="O" AND PEMSTATUS(lvSource,"Name",5)
  360.             lcTitle=ALLTRIM(TRANSFORM(lvSource.Name))
  361.         ELSE
  362.             lcTitle=""
  363.         ENDIF
  364.     ELSE
  365.         lcTitle=_oHTML.cSourceFile
  366.     ENDIF
  367.     _oHTML.Head.Title.Item=lcTitle
  368. ENDIF
  369. IF PEMSTATUS(_oHTML,"Body",5)
  370.     _oHTML.Body.AddItem(_oHTML.oRecord.BodyStart)
  371. ENDIF
  372. _oHTML.nWorkArea=oSaveEnvironment.nLastSelect
  373. IF lnShow=5
  374.     llSuccessful=.T.
  375. ELSE
  376.     llSuccessful=_oHTML.Generate()
  377. ENDIF
  378. SELECT 0
  379. IF NOT llSuccessful
  380.     IF VARTYPE(_oHTML)=="O"
  381.         _oHTML.Release
  382.     ENDIF
  383.     _oHTML=.NULL.
  384.     RETURN .NULL.
  385. ENDIF
  386. _oHTML.RunCode(_oHTML.oRecord.PostScript)
  387. IF PEMSTATUS(_oHTML,"Head",5)
  388.     IF NOT EMPTY(_oHTML.oRecord.Style)
  389.         _oHTML.Head.CSS=_oHTML.Head.AddTag("style")
  390.         _oHTML.Head.CSS.AddItem(_oHTML.oRecord.Style)
  391.     ENDIF
  392.     _oHTML.Head.AddItem(_oHTML.oRecord.HeadEnd)
  393. ENDIF
  394. IF PEMSTATUS(_oHTML,"Body",5) AND NOT ISNULL(_oHTML.Body)
  395.     _oHTML.Body.AddItem(_oHTML.oRecord.BodyEnd)
  396. ENDIF
  397. DO CASE
  398.     CASE lnShow=1
  399.         llSuccessful=_oHTML.ViewSource()
  400.     CASE lnShow=2
  401.         llSuccessful=_oHTML.Show()
  402.     CASE lnShow#5
  403.         llSuccessful=_oHTML.SaveFile()
  404. ENDCASE
  405. IF VARTYPE(_oHTML)#"O"
  406.     _oHTML=.NULL.
  407.     RETURN .NULL.
  408. ENDIF
  409. IF NOT llSuccessful
  410.     _MsgBox(M_UNABLE_TO_CREATE_FILE_LOC+[ "]+_oHTML.cOutFile+[".])
  411. ENDIF
  412. IF NOT ll_oHTMLPublic
  413.     _oHTML.Release
  414.     _oHTML=.NULL.
  415.     RETURN .NULL.
  416. ENDIF
  417. RETURN _oHTML
  418.  
  419.  
  420.  
  421. FUNCTION _EvalLinks(tcLinks,toObject,tcType)
  422. LOCAL lcLinks1,lcLinks2,lcLink,lnLinkTotal,lnCount,lnAtPos,lnLastRecNo
  423.  
  424. lcLinks1=_TransformLinks(tcLinks)
  425. IF EMPTY(lcLinks1)
  426.     RETURN ""
  427. ENDIF
  428. lnLastRecNo=IIF(EOF() OR RECNO()>RECCOUNT(),0,RECNO())
  429. lcLinks2=""
  430. lnLinkTotal=(OCCURS(";",lcLinks1)+1)
  431. FOR lnCount = 1 TO lnLinkTotal
  432.     IF lnCount<lnLinkTotal
  433.         lnAtPos=AT(";",lcLinks1)
  434.         lcLink=ALLTRIM(LEFT(lcLinks1,lnAtPos-1))
  435.         lcLinks1=ALLTRIM(SUBSTR(lcLinks1,lnAtPos+1))
  436.     ELSE
  437.         lcLink=ALLTRIM(lcLinks1)
  438.         lcLinks1=""
  439.     ENDIF
  440.     IF EMPTY(lcLink)
  441.         LOOP
  442.     ENDIF
  443.     LOCATE FOR LOWER(ALLTRIM(ID))==LOWER(ALLTRIM(lcLink))
  444.     IF NOT EOF() AND (EMPTY(tcType) OR ALLTRIM(UPPER(tcType))==ALLTRIM(UPPER(Type)))
  445.         SCATTER MEMO NAME oNewObject
  446.         _InheritProperties(toObject,oNewObject)
  447.         lcLink=_EvalLinks(Links,toObject,tcType)
  448.         IF EMPTY(lcLink)
  449.             LOOP
  450.         ENDIF
  451.     ENDIF
  452.     lcLinks2=lcLinks2+lcLink+";"
  453. ENDFOR
  454. IF lnLastRecNo>0
  455.     GO lnLastRecNo
  456. ENDIF
  457. RETURN lcLinks2
  458. ENDFUNC
  459.  
  460.  
  461.  
  462. FUNCTION _TransformLinks(tcLinks)
  463. LOCAL lcLinks
  464.  
  465. IF EMPTY(tcLinks)
  466.     RETURN ""
  467. ENDIF
  468. lcLinks=STRTRAN(STRTRAN(STRTRAN(STRTRAN(ALLTRIM(tcLinks),CR_LF,";"), ;
  469.         LF,";"),CR,";"),",",";")
  470. IF LEFT(lcLinks,1)==";"
  471.     lcLinks=ALLTRIM(SUBSTR(lcLinks,2))
  472. ENDIF
  473. IF RIGHT(lcLinks,1)==";"
  474.     lcLinks=ALLTRIM(LEFT(lcLinks,LEN(lcLinks)-1))
  475. ENDIF
  476. RETURN lcLinks
  477. ENDFUNC
  478.  
  479.  
  480.  
  481. FUNCTION _InheritProperties(toObject,toNewObject)
  482.  
  483. IF EMPTY(toObject.Type) AND NOT EMPTY(toNewObject.Type)
  484.     toObject.Type=toNewObject.Type
  485. ENDIF
  486. IF EMPTY(toObject.Text) AND NOT EMPTY(toNewObject.Text)
  487.     toObject.Text=toNewObject.Text
  488. ENDIF
  489. IF EMPTY(toObject.Desc) AND NOT EMPTY(toNewObject.Desc)
  490.     toObject.Desc=toNewObject.Desc
  491. ENDIF
  492. IF EMPTY(toObject.ClassName) AND NOT EMPTY(toNewObject.ClassName)
  493.     toObject.ClassName=toNewObject.ClassName
  494. ENDIF
  495. IF EMPTY(toObject.ClassLib) AND NOT EMPTY(toNewObject.ClassLib)
  496.     toObject.ClassLib=toNewObject.ClassLib
  497. ENDIF
  498. IF EMPTY(toObject.Module) AND NOT EMPTY(toNewObject.Module)
  499.     toObject.Module=toNewObject.Module
  500. ENDIF
  501. IF EMPTY(toObject.Picture) AND NOT EMPTY(toNewObject.Picture)
  502.     toObject.Picture=toNewObject.Picture
  503. ENDIF
  504. toObject.Properties=_InheritProperty(toObject.Properties,toNewObject.Properties)
  505. toObject.HTML=_InheritProperty(toObject.HTML,toNewObject.HTML)
  506. toObject.Style=_InheritProperty(toObject.Style,toNewObject.Style)
  507. toObject.Script=_InheritProperty(toObject.Script,toNewObject.Script)
  508. toObject.PreScript=_InheritProperty(toObject.PreScript,toNewObject.PreScript)
  509. toObject.GenScript=_InheritProperty(toObject.GenScript,toNewObject.GenScript)
  510. toObject.PostScript=_InheritProperty(toObject.PostScript,toNewObject.PostScript)
  511. toObject.HeadStart=_InheritProperty(toObject.HeadStart,toNewObject.HeadStart)
  512. toObject.BodyStart=_InheritProperty(toObject.BodyStart,toNewObject.BodyStart)
  513. toObject.BodyEnd=_InheritProperty(toObject.BodyEnd,toNewObject.BodyEnd)
  514. toObject.HeadEnd=_InheritProperty(toObject.HeadEnd,toNewObject.HeadEnd)
  515. IF NOT EMPTY(toNewObject.BodyEnd)
  516.     IF EMPTY(toObject.BodyEnd)
  517.         toObject.BodyEnd=toNewObject.BodyEnd
  518.     ELSE
  519.         toObject.BodyEnd=toObject.BodyEnd+CR_LF+toNewObject.BodyEnd
  520.     ENDIF
  521. ENDIF
  522. IF EMPTY(toObject.Comment) AND NOT EMPTY(toNewObject.Comment)
  523.     toObject.Comment=toNewObject.Comment
  524. ENDIF
  525. IF EMPTY(toObject.User) AND NOT EMPTY(toNewObject.User)
  526.     toObject.User=toNewObject.User
  527. ENDIF
  528. ENDFUNC
  529.  
  530.  
  531.  
  532. FUNCTION _InheritProperty(tcValue,tcNewValue)
  533.  
  534. IF EMPTY(tcNewValue)
  535.     RETURN tcValue
  536. ENDIF
  537. IF EMPTY(tcValue)
  538.     RETURN tcNewValue
  539. ENDIF
  540. IF RIGHT(tcNewValue,2)==CR_LF
  541.     RETURN tcNewValue+tcValue
  542. ENDIF
  543. RETURN tcNewValue+CR_LF+tcValue
  544. ENDFUNC
  545.  
  546.  
  547.  
  548. FUNCTION _CheckGenHTMLTableStructure(tcFileName,tcAlias,tcHTMLVCX)
  549. LOCAL lcFileName,lcPath,lcAlias2,lcLastOnError,oRecord,lcID,lcVersion
  550. LOCAL lcFileName2DBF,lcFileName2FPT,oHTMLCreateTable
  551.  
  552. lcFileName=LOWER(tcFileName)
  553. lcPath=IIF(EMPTY(lcFileName),"",JUSTPATH(lcFileName)+"\")
  554. IF RECCOUNT()=0
  555.     USE
  556.     oHTMLCreateTable=NEWOBJECT("_HTMLCreateTable",tcHTMLVCX,"")
  557.     oHTMLCreateTable.CreateTable(lcFileName)
  558.     lcLastOnError=ON("ERROR")
  559.     ON ERROR =.F.
  560.     USE (lcFileName) AGAIN SHARED ALIAS (tcAlias)
  561.     IF EMPTY(lcLastOnError)
  562.         ON ERROR
  563.     ELSE
  564.         ON ERROR &lcLastOnError
  565.     ENDIF
  566.     IF NOT USED()
  567.         _MsgBox(M_UNABLE_TO_CREATE_FILE_LOC+[ "]+lcFileName+[".])
  568.         RETURN .F.
  569.     ENDIF
  570.     RETURN
  571. ENDIF
  572. LOCATE FOR LOWER(ALLTRIM(ID))="vfpdefault"
  573. lcVersion=IIF(TYPE(tcAlias+".Version")=="M",ALLTRIM(Version),"")
  574. oHTMLCreateTable=NEWOBJECT("_HTMLCreateTable",tcHTMLVCX,"")
  575. IF VARTYPE(oHTMLCreateTable)#"O" OR (FCOUNT()>=25 AND FIELD(25)=="SAVE" AND ;
  576.         lcVersion>=oHTMLCreateTable.cTableVersion)
  577.     RETURN
  578. ENDIF
  579. lcLastOnError=ON("ERROR")
  580. ON ERROR =.F.
  581. USE (lcFileName) EXCLUSIVE ALIAS (tcAlias)
  582. IF EMPTY(lcLastOnError)
  583.     ON ERROR
  584. ELSE
  585.     ON ERROR &lcLastOnError
  586. ENDIF
  587. IF NOT USED()
  588.     _MsgBox(M_FILE_LOC+[ "]+lcFileName+[" ]+M_COULD_NOT_OPENED_EXCL_LOC)
  589.     RETURN .F.
  590. ENDIF
  591. lcFileName2DBF=LOWER(FORCEPATH(FORCEEXT(lcFileName,"")+"__2",lcPath))
  592. lcFileName2FPT=lcFileName2DBF+".fpt"
  593. lcFileName2DBF=lcFileName2DBF+".dbf"
  594. ERASE (lcFileName2DBF)
  595. ERASE (lcFileName2FPT)
  596. IF TYPE(tcAlias+".Save")=="L"
  597.     COPY TO (lcFileName2DBF) FOR Save AND NOT LOWER(ALLTRIM(ID))="vfpdefault"
  598. ENDIF
  599. USE
  600. ERASE (lcFileName)
  601. oHTMLCreateTable.CreateTable(lcFileName)
  602. lcLastOnError=ON("ERROR")
  603. ON ERROR =.F.
  604. USE (lcFileName) AGAIN SHARED ALIAS (tcAlias)
  605. IF EMPTY(lcLastOnError)
  606.     ON ERROR
  607. ELSE
  608.     ON ERROR &lcLastOnError
  609. ENDIF
  610. IF NOT USED()
  611.     ERASE (lcFileName2DBF)
  612.     ERASE (lcFileName2FPT)
  613.     _MsgBox(M_UNABLE_TO_CREATE_FILE_LOC+[ "]+lcFileName+[".])
  614.     RETURN .F.
  615. ENDIF
  616. IF NOT FILE(lcFileName2DBF)
  617.     RETURN
  618. ENDIF
  619. lcAlias2=LOWER(SYS(2015))
  620. SELECT 0
  621. lcLastOnError=ON("ERROR")
  622. ON ERROR =.F.
  623. USE (lcFileName2DBF) EXCLUSIVE ALIAS (lcAlias2)
  624. SCAN ALL
  625.     lcID=LOWER(ALLTRIM(ID))
  626.     SCATTER MEMO NAME oRecord
  627.     SELECT (tcAlias)
  628.     IF EMPTY(lcID)
  629.         APPEND BLANK
  630.     ELSE
  631.         LOCATE FOR LOWER(ALLTRIM(ID))==lcID
  632.         IF EOF()
  633.             APPEND BLANK
  634.         ENDIF
  635.     ENDIF
  636.     GATHER MEMO NAME oRecord
  637.     SELECT (tcAlias)    
  638. ENDSCAN
  639. IF EMPTY(lcLastOnError)
  640.     ON ERROR
  641. ELSE
  642.     ON ERROR &lcLastOnError
  643. ENDIF
  644. USE
  645. ERASE (lcFileName2DBF)
  646. ERASE (lcFileName2FPT)
  647. SELECT (tcAlias)
  648. LOCATE
  649. ENDFUNC
  650.  
  651.  
  652.  
  653. FUNCTION _MsgBox(tcMessage,tnType)
  654. LOCAL lnType,lnResult,lnLastSelect
  655.  
  656. lnType=IIF(VARTYPE(tnType)=="N",tnType,16)
  657. lnLastSelect=SELECT()
  658. SELECT 0
  659. WAIT CLEAR
  660. lnResult=MESSAGEBOX(tcMessage,lnType,M_GENHTML_LOC)
  661. WAIT CLEAR
  662. SELECT (lnLastSelect)
  663. RETURN lnResult
  664. ENDFUNC
  665.  
  666.  
  667.  
  668. DEFINE CLASS _SaveEnvironment AS Custom
  669.  
  670.  
  671.     cGenHTMLAlias=""
  672.     nGenHTMLRecNo=0
  673.     cGenHTMLTable=""
  674.     nLastSelect=0
  675.     nLastRecNo=0
  676.     nLastSetMemoWidth=0
  677.     cLastSetMessageBar=""
  678.     cLastSetSafety=""
  679.     cLastSetTalk=""
  680.     cWindow=""
  681.     lWindow=.F.
  682.  
  683.  
  684.     FUNCTION Init
  685.     this.cLastSetTalk=SET("TALK")
  686.     SET TALK OFF
  687.     this.cLastSetSafety=SET("SAFETY")
  688.     SET SAFETY OFF
  689.     this.nLastSetMemoWidth=SET("MEMOWIDTH")
  690.     SET MEMOWIDTH TO 1024
  691.     this.cLastSetMessageBar=SET("MESSAGE",1)
  692.     SET MESSAGE TO ""
  693.     this.nLastSelect=SELECT()
  694.     this.nLastRecNo=IIF(EOF() OR RECNO()>RECCOUNT(),0,RECNO())
  695.     ENDFUNC
  696.     
  697.  
  698.     FUNCTION Destroy
  699.     IF NOT EMPTY(this.cWindow) AND WEXIST(this.cWindow)
  700.         IF this.lWindow
  701.             SHOW WINDOW (M_PROPERTIES_LOC)
  702.         ENDIF
  703.         RELEASE WINDOW (this.cWindow)
  704.     ENDIF
  705.     SET MEMOWIDTH TO (this.nLastSetMemoWidth)
  706.     IF USED(this.cGenHTMLAlias)
  707.         USE IN (this.cGenHTMLAlias)
  708.     ENDIF
  709.     SELECT (this.nLastSelect)
  710.     IF USED() AND this.nLastRecNo>0
  711.         GO this.nLastRecNo
  712.     ENDIF
  713.     IF EMPTY(this.cLastSetMessageBar)
  714.         SET MESSAGE TO
  715.     ELSE
  716.         SET MESSAGE TO (this.cLastSetMessageBar)
  717.     ENDIF
  718.     IF this.cLastSetSafety=="ON"
  719.         SET SAFETY ON
  720.     ELSE
  721.         SET SAFETY OFF
  722.     ENDIF
  723.     IF this.cLastSetTalk=="ON"
  724.         SET TALK ON
  725.     ELSE
  726.         SET TALK OFF
  727.     ENDIF
  728.     ENDFUNC
  729.  
  730.  
  731. ENDDEFINE
  732.  
  733.  
  734.  
  735. *-- end GenHTML.PRG
  736.